perm filename RGB2IC.SAI[DD,BGB] blob
sn#032891 filedate 1973-07-03 generic text, type T, neo UTF8
00100 BEGIN "RGB"
00200
00300 REQUIRE "PROLOG.HDR[1,PDQ]" SOURCE_FILE;
00400 REQUIRE "COMSUB.HDR[1,PDQ]" SOURCE_FILE;
00500 REQUIRE "PICIO.HDR[1,PDQ]" SOURCE_FILE;
00600 REQUIRE "PICOPS.HDR[1,PDQ]" SOURCE_FILE;
00700
00800 PICTURE PIC1,PIC2,PIC3[0:PICMAX];
00900 INTEGER SCALE; STRING NAM;
01000
01100 SIMPLE PROCEDURE RGB2IC(PICTURE PIC1,PIC2,PIC3);
01200 BEGIN INTEGER SIZX,SIZY,SIZL,PT1,OPT1,PT2,OPT2,PT3,OPT3,XPT2,
01300 HINT,INT,INT1,INT2,PT,LIN,R,G,B,R1,R2,G1,G2,B1,B2,X,Y;
01400
01500 SIZX←PIC1[SIZEX]; SIZY←PIC1[SIZEY]; SIZL←PIC1[SIZEL];
01550 OUTSTR(" SIZX "&CVS(SIZX)&" SIZY "&CVS(SIZY)&" SIZL "&CVS(SIZL)&CRLF);
01600 OPT1←PIC1[PTR]; OPT2←PIC2[PTR]; OPT3←PIC3[PTR];
01650 OUTSTR(" OPT1 "&CVOS(OPT1)&" OPT2 "&CVOS(OPT2)&" OPT3 "&CVOS(OPT3)&CRLF);
01700 HINT←1 LSH (PIC1[BIT]-1);
01800 FOR LIN←1 STEP 1 UNTIL SIZY DO
01900 BEGIN PT1←OPT1; PT2←OPT2; PT3←OPT3;
02000 FOR PT←1 STEP 2 UNTIL SIZX DO
02100 BEGIN R1←ILDB(PT1); G1←ILDB(PT2); B1←ILDB(PT3);
02200 INT1←R1+G1+B1;
02300 DPB(INT1 DIV 3,PT1);
02400 XPT2←PT2;
02500 R2←ILDB(PT1); G2←ILDB(PT2); B2←ILDB(PT3);
02600 INT2←R2+G2+B2;
02700 DPB(INT2 DIV 3,PT1);
02800 R←R1+R2; G←G1+G2; INT←INT1+INT2;
02900 X←(3*R-INT) DIV 6 + HINT;
03000 Y←(3*G-INT) DIV 6 + HINT;
03100 DPB(X,XPT2); DPB(Y,PT2);
03200 END;
03300 OPT1←OPT1+SIZL; OPT2←OPT2+SIZL; OPT3←OPT3+SIZL;
03400 END;
03500 END "RGB2IC";
03600
03700 WHILE TRUE DO
03800 BEGIN NAM←STRIN("FILE NAME=");
03900 RECPIC(PIC1,0,"R"&NAM);
04000 RECPIC(PIC2,0,"G"&NAM);
04100 RECPIC(PIC3,0,"B"&NAM);
04200 RGB2IC(PIC1,PIC2,PIC3);
04300 SNDPIC(PIC1,NULL,"I"&NAM);
04400 SNDPIC(PIC2,NULL,"C"&NAM);
04500 PICREL(PIC1); PICREL(PIC2); PICREL(PIC3);
04600 END;
04700
04800 END "RGB"